home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb11.zip / PWRI.INC < prev    next >
Text File  |  1986-01-21  |  2KB  |  67 lines
  1.  
  2. Function RLScan(X : real; N : integer): real;
  3.  
  4. {Written by Paul F. Hultquist.  Found in May 1985 PC Tech Journal.           }
  5. {This function scans the positive exponent N from right to left to determine }
  6. {a sequence of multiplications and squarings that produce X (real) to the    }
  7. {power N (integer) in a near minimum number of multiplications.  It is used  }
  8. {as a function in the function PwrI, listed below.  The algorithm is         }
  9. {Algorithm A, page 442 Vol. 2, 2nd Ed. of Knuth:  "The Art of Computer       }
  10. {Programming:  Seminumerical Algorithms", Addison-Wesley, 1981.              }
  11.  
  12. Var
  13.   Y, Z  :  real;
  14.   O     :  boolean;
  15.   BigN  :  integer;
  16.  
  17. Begin
  18.   BigN := N;
  19.   Y := 1.0;
  20.   Z := X;
  21.   While BigN > 0 do
  22.     begin
  23.       O := odd(BigN);
  24.       BigN := BigN Div 2;
  25.       If O then
  26.         begin
  27.           Y := Y * Z;
  28.           RLScan := Y
  29.         end;
  30.       Z := Z * Z;
  31.     end;
  32. End; {RLScan}
  33.  
  34. Function PwrI(X : real; N : integer): real;
  35.  
  36. {Written by Paul F. Hultquist.  Found in May 1985 PC Tech Journal.           }
  37. {PwrI performs the test necessary to eliminate the noncomputable cases of    }
  38. {finding X (real) to the power N (integer).  It calls upon function RLScan to}
  39. {do the actual computation after it has, for example, replaced a negative    }
  40. {exponent by a positive one (it does a reciprocation after return from RLScan}
  41. {in that case).                                                              }
  42.  
  43. Begin
  44.   if (N > 0) then
  45.     PwrI := RLScan(X,N)
  46.   else
  47.     if (X <> 0.0) and (N < 0) then
  48.       begin
  49.         N := -N;
  50.         PwrI := 1.0/RLScan(X,N);
  51.       end
  52.     else
  53.       if (N = 0) and (X <> 0) then
  54.         PwrI := 1.0
  55.       else
  56.         if (N = 0) and (X  = 0) then
  57.           begin
  58.             writeln('0 to the 0 power.  Halt.');
  59.             Halt;
  60.           end
  61.         else
  62.           if (N < 0) and (X =0) then
  63.             begin
  64.               writeln('Division by zero.  Halt.');
  65.               Halt;
  66.             end;
  67. End;  {PwrI}